home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / Internet / Finger 1.3.5 ƒ / Tokens / FILES.p < prev    next >
Encoding:
Text File  |  1991-12-02  |  1.5 KB  |  75 lines  |  [TEXT/PJMM]
  1. unit FILES;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ParameterDef;
  7.  
  8.     procedure Main (var p: parameterRecord);
  9.  
  10. implementation
  11.  
  12.     procedure Main (var p: parameterRecord);
  13.         var
  14.             rn, i: integer;
  15.             count, len: longInt;
  16.             s: str255;
  17.             oe, ooe: OSErr;
  18.         function MyFSRead (len: integer; buf: ptr): OSErr;
  19.             var
  20.                 l: longInt;
  21.                 oe: OSErr;
  22.         begin
  23.             l := len;
  24.             oe := FSRead(rn, l, buf);
  25.             if oe = eofErr then
  26.                 oe := noErr;
  27.             if (oe = noErr) and (len <> l) then
  28.                 oe := eofErr;
  29.             MyFSRead := oe;
  30.         end;
  31.         function MyFSOpen (s: str255): OSErr;
  32.             var
  33.                 i: integer;
  34.         begin
  35.             for i := 1 to length(s) - 1 do    { Disallow going back up the tree, obvious security breach }
  36.                 if (s[i] = ':') and (s[i + 1] = ':') then
  37.                     s[i] := '-';
  38.             MyFSOpen := FSOpen(s, 0, rn);
  39.         end;
  40.     begin
  41.         p.expandtokens := true;
  42.         s := p.param^;
  43.         if s = '' then
  44.             s := ':Preferences:Files:'
  45.         else
  46.             s := concat(s, ':');
  47.         if p.fingeredname^ = '' then
  48.             oe := MyFSOpen(concat(s, '@'))
  49.         else
  50.             oe := MyFSOpen(concat(s, p.fingeredname^));
  51.         if oe <> noErr then
  52.             oe := MyFSOpen(concat(s, '?'));
  53.         if oe = noErr then begin
  54.             oe := GetEOF(rn, count);
  55.             while (count > 0) and (oe = noErr) do begin
  56.                 if count > 256 then
  57.                     len := 256
  58.                 else
  59.                     len := count;
  60.                 oe := MyFSRead(len, @s);
  61.                 count := count - len;
  62.                 if len > p.hlength - p.offset then
  63.                     len := p.hlength - p.offset;
  64.                 if len > 0 then begin
  65.                     BlockMove(@s, ptr(longInt(p.fingeroutput^) + p.offset), len);
  66.                     p.offset := p.offset + len;
  67.                 end
  68.                 else
  69.                     oe := eofErr;
  70.             end;
  71.             ooe := FSClose(rn);
  72.         end;
  73.     end;
  74.  
  75. end.